home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / winpascl.arc / SMOKER.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-24  |  2KB  |  111 lines
  1. PROGRAM CigSmok(Input, Output);
  2.  
  3.    CONST
  4.       NumCig         = 15; {  # of cigarettes for each smoker }
  5.       paper          = 1;  {      .                           }
  6.       match          = 3;  {      .   Resources               }
  7.       tobacco        = 5;  {      .                           }
  8.  
  9.    TYPE
  10.       semaphore = Integer;
  11.       resource  = Integer;
  12.  
  13.    VAR
  14.       S              : ARRAY[1..8] OF semaphore;
  15.       alive          : ARRAY[1..8] OF Boolean;
  16.       NumLeft        : ARRAY[1..3] of integer;
  17.       a              : semaphore;
  18.       k, m           : Integer;
  19.  
  20.    FUNCTION VALID(a, b : resource) : Boolean;
  21.    BEGIN
  22.       VALID := False;
  23.       IF a<>b then
  24.          IF alive[a+b] THEN
  25.             VALID := True;
  26.       END;
  27.  
  28.    PROCEDURE agent;
  29.       VAR
  30.          r1, r2      : resource;
  31.          j           : Integer;
  32.    BEGIN
  33.       FOR j := 1 TO 3*NumCig DO BEGIN
  34.          WAIT(a);
  35.          REPEAT
  36.             r1 := 2*random(3) + 1;
  37.             r2 := 2*random(3) + 1;
  38.          UNTIL VALID(r1, r2);
  39.          SIGNAL(S[r1+r2]);
  40.          END;
  41.      END;
  42.  
  43.    procedure display;
  44.    var
  45.       loop         : Integer;
  46.    begin
  47.       Disable;
  48. {      write( chr(27),'[2J' ); }
  49.       ClrScr;
  50.  
  51.       for loop := 1 to 3 do
  52.          if ( NumLeft[loop] > 0 ) then
  53.             writeln( '=':NumLeft[loop] )
  54.          else
  55.             writeln( 'OX' );
  56.       Enable;
  57.    end;
  58.  
  59.    procedure beep;
  60.    begin
  61.       Disable;
  62.       Sound( 100 );
  63.       Delay( 250 );
  64.       NoSound;
  65.       Enable;
  66.    end;
  67.  
  68.    procedure smoker(r3 : resource);
  69.    var
  70.       i          : resource;
  71.       j, y       : Integer;
  72.    begin
  73.       i := (paper+match+tobacco)-r3;
  74.       j := NumCig;
  75.       y := (r3+1) div 2;
  76.  
  77.       repeat
  78.          wait( s[i] );
  79.  
  80.          j := j - 1;
  81.          NumLeft[y] := j;
  82.  
  83.          display;
  84. {         write( chr(27), '[', r3:1, ';', j:1, 'H', ' '); }
  85.          if j = 0 then 
  86.             alive[i] := False;
  87.          signal(a)
  88.       until j = 0;
  89.       beep;
  90.       end;
  91.  
  92. BEGIN
  93. {   writeln( chr(27),'[2J' ); }
  94.    ClrScr;
  95.  
  96.    a := 1;
  97.    FOR k := 1 TO 8 DO S[k] := 0; { Zero Semaphore array }
  98.    FOR k := 1 TO 8 DO alive[k] := True;
  99.    FOR k := 1 TO 3 DO NumLeft[k] := NumCig;
  100.  
  101.    for m:=0 to 2 do 
  102.       begin
  103.       writeln( '=':NumCig );
  104.       end;
  105.  
  106.    cobegin
  107.    agent;
  108.    smoker(paper); smoker(match); smoker(tobacco)
  109.    coend;
  110.    END.
  111.